(in-package :lilu-mcclim-apropos)

(defclass fully-qualified-symbol-view (clim:textual-view)
  ())

(defparameter +fully-qualified-symbol-view+
  (make-instance 'fully-qualified-symbol-view))

(clim:define-presentation-type matched-symbol () :inherit-from '(matched-object))

(clim:define-presentation-method clim:present (object (type matched-symbol) stream
                                                      (view clim:textual-view)
                                                      &key acceptably for-context-type)
  (declare (ignore acceptably for-context-type))
  (let ((*package* (find-package :common-lisp-user)))
    (princ object stream)))

(clim:define-presentation-method clim:present (object (type matched-symbol) stream
                                                      (view fully-qualified-symbol-view)
                                                      &key acceptably for-context-type)
  (declare (ignore acceptably for-context-type))
  (let ((*package* (find-package :common-lisp-user)))
    (prin1 object stream)))


(defparameter *symbol-apropos-frame-subclas-of-options*
  (list (cons "nil" nil)
        (cons "sheet" 'clim:sheet)
        (cons "pane" 'clim:pane)
        (cons "gadget" 'clim:gadget)
        (cons "view" 'clim:view)
        (cons "presentation" 'clim:presentation)
        (cons "command-table" 'clim:command-table)
        (cons "application-frame" 'clim:application-frame)))
;;;
;;; application frame
;;;


(clim:define-application-frame symbol-apropos-frame (iapropos-application-frame)
  ((selected-result-options :initform '(:fully-qualified))
   (selected-output-option :initform ':selection)
   (symbol-view :initform +fully-qualified-symbol-view+))
  (:default-initargs
   :iapropos (make-instance 'symbol-iapropos)
   :presentation-type 'matched-symbol
   :object-name "Symbol")
  (:command-table (symbol-apropos-frame-command-table
                   :inherit-from (iapropos-command-table
                                  iapropos-edit-command-table)
                   :menu (("Edit" :menu iapropos-edit-command-table)
                          ("Quit" :menu iapropos-command-table))))
  (:panes
   (symbol-result-display
    (make-ipropos-frame-matched-objects-pane))
   (output-display
    (make-ipropos-frame-selected-objects-pane))
   (matched-packages
    (make-ipropos-frame-matched-object-packages-pane))
   (symbol-regex-text-field
    (make-iapropos-frame-option-regex-pane :symbol-name-regex))
   (object-package-regex-text-field ;;package-regex-text-field
    (make-iapropos-frame-option-regex-pane :package-name-regex))
   (result-options
    (clim:with-radio-box (:type :some-of
                          :orientation :horizontal
                          :value-changed-callback '%update-result-options)
      (clim:radio-box-current-selection "fully-qualified")))
   (output-option
    (clim:with-radio-box (:orientation :horizontal
                          :value-changed-callback '%update-output-option)
      (clim:radio-box-current-selection "normal")
      "description"))
   (options
    (clim:vertically nil
      (clim:labelling (:label "Symbol")
        (clim:vertically nil
          (make-iapropos-frame-option-value-pane :bound-to :vertical)
          (make-iapropos-frame-option-value-pane :external-p :horizontal)
          (make-iapropos-frame-option-value-pane :documentation-p :horizontal)
          (make-iapropos-frame-option-value-pane :location-p :horizontal)))
      (clim:labelling (:label "Class")
        (clim:vertically nil
          (make-iapropos-frame-option-pane-from-items
           :subclass-of  *symbol-apropos-frame-subclas-of-options*)))
      (clim:labelling (:label "Selection")
        (make-iapropos-frame-selection-type-pane))
      (clim:+fill+)))
   (actions (clim:labelling (:label "Actions")
              (make-iapropos-frame-action-pane))))
  (:layouts
   (:default
    (clim:horizontally nil
      (clim:vertically nil
        options
        clim:+fill+)
      (clim:+fill+
       (clim:vertically nil
         (2/3 (clim:labelling (:label "Results")
                (clim:vertically nil
                  result-options
                  (clim:horizontally nil
                    (2/5 matched-packages)
                    (3/5 symbol-result-display)))))
         (1/3 (clim:labelling (:label "Output")
                (clim:vertically nil
                  (clim:horizontally nil
                    output-option clim:+fill+)
                  output-display)))
         (clim:horizontally nil
           actions
           (clim:+fill+
            (clim:vertically nil
              (clim:labelling (:label "symbol apropos" :align-x :center)
                symbol-regex-text-field)
              (clim:labelling (:label "package apropos" :align-x :center)
                object-package-regex-text-field))))))))))

;;;
;;; frame initialization
;;;

(defmethod initialize-instance :after ((frame symbol-apropos-frame) &key &allow-other-keys)
  )

(defmethod  iapropos-frame-reset-option-panes ((frame symbol-apropos-frame))
  (call-next-method)
  (with-slots (iapropos option-panes) frame
    (if (eql (iapropos-option-value iapropos :bound-to) :class)
        (progn
          (clim:activate-gadget (getf option-panes :subclass-of))
          (clim:activate-gadget (getf option-panes :metaclass-of)))
        (progn
          (clim:deactivate-gadget (getf option-panes :subclass-of))
          (clim:deactivate-gadget (getf option-panes :metaclass-of))))
    (if (not (eql (iapropos-option-value iapropos :bound-to) :any))
        (progn
          (clim:activate-gadget (getf option-panes :documentation-p))
          (clim:activate-gadget (getf option-panes :location-p)))
        (progn
          (clim:deactivate-gadget (getf option-panes :documentation-p))
          (clim:deactivate-gadget (getf option-panes :location-p))))))

(defmethod iapropos-frame-update-option-value ((frame symbol-apropos-frame) option selected-value)
  (call-next-method)
  (with-slots (option-panes) frame
    (when (eql option :bound-to)
      (if (string= selected-value :class)
          (progn
            (clim:activate-gadget (getf option-panes :subclass-of)))
          (progn
            (clim:deactivate-gadget (getf option-panes :subclass-of))))
      (if (not (eql selected-value :any))
          (progn
            (clim:activate-gadget (getf option-panes :documentation-p))
            (clim:activate-gadget (getf option-panes :location-p)))
          (progn
            (clim:deactivate-gadget (getf option-panes :documentation-p))
            (clim:deactivate-gadget (getf option-panes :location-p)))))
    (when (eql option :package-name-regex)
      (iapropos-frame-redisplay-pane 'package-result-display))))

(defmethod iapropos-frame-reset-options ((frame symbol-apropos-frame))
  (call-next-method)
  (with-slots (iapropos option-panes) clim:*application-frame*
    (clim:activate-gadget (getf option-panes :bound-to))
    (clim:activate-gadget (getf option-panes :external-p))
    (clim:deactivate-gadget (getf option-panes :documentation-p))
    (clim:deactivate-gadget (getf option-panes :location-p))
    (clim:deactivate-gadget (getf option-panes :subclass-of))))

;;;
;;;
;;;

(defmethod ipropos-frame-matched-objects-display ((frame symbol-apropos-frame) pane &key (presentation-view clim:+textual-view+))
  (with-slots (symbol-view) frame
    (call-next-method frame pane :presentation-view symbol-view)))

(defmethod ipropos-frame-selected-objects-display ((frame symbol-apropos-frame) pane)
  (with-slots (selected-output-option) frame
    (if (eql selected-output-option :description)
        (let ((*ignored-properties* (list :object :source :documentation)))
          (call-next-method))
        (let ((*ignored-properties* (list :description)))
          (call-next-method)))))

;;;
;;; callbacks
;;;

(defun %update-output-option (this-gadget selected-gadget)
  (declare (ignore this-gadget))
  (with-slots (selected-output-option) clim:*application-frame*
    (setf selected-output-option 
          (intern (string-upcase (clim:gadget-label selected-gadget)) :keyword)))
  (iapropos-frame-refresh-selected-objects-pane clim:*application-frame*))

(defun %update-result-options (this-gadget selected-gadgets)
  (declare (ignore this-gadget))
  (with-slots (selected-result-options symbol-view) clim:*application-frame*
    (setf selected-result-options nil)
    (dolist (sg selected-gadgets)
      (push 
       (string-to-keyword (clim:gadget-label sg))
       selected-result-options))
    (if (member :fully-qualified selected-result-options)
        (setf symbol-view +fully-qualified-symbol-view+)
        (setf symbol-view clim:+textual-view+)))
  (iapropos-frame-refresh-metched-objects-pane clim:*application-frame*))

;;;
;;; render functions
;;;

;;;
;;; run
;;;

(defun run-symbol-apropos (&key (new-process nil)
                                (width 790)
                                (height 550)
                                port
                                frame-manager
                                (pretty-name "Apropos Navigator")
                             (process-name "symbol-apropos-frame"))
      (run-iapropos-application-frame 'symbol-apropos-frame
                                  :new-process new-process
                                  :width width
                                  :height height
                                  :port port
                                  :frame-manager frame-manager
                                  :pretty-name pretty-name
                                  :process-name process-name))
